home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
050
/
phone.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-02-26
|
8KB
|
283 lines
Program Phone;
Type
String15 = String[15];
NumNodePtr = ^NumNode;
NumNode = Record
Name,Number : String15;
Next : NumNodePtr;
End;
NumRecType = Record
Name, Number : String15
End;
Var
Base, Cur : NumNodePtr;
NumFile : File of NumRecType;
Done : Boolean;
{ Init will fetch the info from phone.lst and form a linked list
with it. If the file does not exist, it will create it instead. }
Procedure Init;
Var
NumRec : NumRecType;
FirstUse : Boolean;
Num : Integer;
Begin
Done := False;
Assign(NumFile,'Phone.lst');
Base := Nil;
Cur := Base;
{$I-} Reset(NumFile) {$I+};
FirstUse := (IOResult <> 0);
If FirstUse then Rewrite(NumFile)
Else
While not(EOF(NumFile)) do
Begin
If Cur = Nil then { Create base node }
Begin
New(Cur);
Base := Cur
End
Else { Create non base node }
Begin
New(Cur^.Next);
Cur := Cur^.Next;
End;
Read(NumFile,NumRec); { Fill list node from file }
Cur^.Name := NumRec.Name;
Cur^.Number := NumRec.Number;
Cur^.Next := Nil
End;
Close(NumFile);
End;
{ UpdateFile will save the linked list in virtual memory to disk
into Phone.lst on thecurrent directory }
Procedure UpdateFile;
Var
Num : Integer;
c : NumNodePtr;
NumRec : NumRecType;
Begin
c := Base;
Rewrite(NumFile);
NumRec.Name := ''; NumRec.Number := '';
For Num := 1 to 100 do Write(NumFile,NumRec);
Rewrite(NumFile);
While c <> Nil do
Begin
NumRec.Name := c^.Name;
NumRec.Number := c^.Number;
Write(NumFile,NumRec);
c := c^.Next
End;
Close(NumFile);
End;
Procedure AddNode;
Var
Name,Number : String15;
c,p,Temp : NumNodePtr;
Begin
ClrScr;
GotoXY(10,10); Write('Enter name : '); Readln(Name);
GotoXY(10,12); Write('Enter number : '); Readln(Number);
c := Base;
While (not((Name > c^.Name) and (Name < c^.Next^.Name)))
and (c <> Nil) and (Name > c^.Name) DO
Begin
p := c;
c := c^.Next;
End;
If c = Nil then { Add node to end of list }
Begin
New(c);
If Base = Nil then Base := c
Else p^.Next := c;
c^.Next := Nil;
c^.Name := Name;
c^.Number := Number;
End
Else If (c = Base) and (c^.Name > Name) then
Begin { Add node to begining of list }
New(c);
c^.Name := Name;
c^.Number := Number;
c^.Next := Base;
Base := c
End
Else { Add node into middle of list }
Begin
Temp := c^.Next;
c^.Next := nil;
New(c^.Next);
c^.Next^.Name := Name;
c^.Next^.Number := Number;
c^.Next^.Next := Temp;
End;
End;
Procedure PrintList;
Var
x : Char;
c : NumNodePtr;
str : String15;
num,i : Integer;
Begin
ClrScr;
GotoXY(10,10);Write('Send output to printer ? ');Readln(x);
c := Base;
If x in ['y','Y'] then
Begin
Writeln(lst);Writeln(lst);
Writeln(lst,' Name Phone Number ');
Writeln(lst,' ------ -------------- ');
Writeln(lst);
End
Else
Begin
Writeln;Writeln;
GotoXY(10,13);Writeln(' Name Phone Number ');
GotoXY(10,14);Writeln(' ------ -------------- ');
Writeln;
End;
While c <> Nil do
Begin
num := 15 - length(c^.Name);
str := ' ';
For i := 1 to num do str := str + ' ';
If x in ['y','Y'] then
Writeln(lst,' ',c^.Name,str,c^.Number)
Else
Writeln(' ',c^.Name,str,c^.Number);
c := c^.Next
End;
Writeln;Writeln(' Hit return to continue');Read(x);
End;
Procedure FindNode(Var p : NumNodePtr;Str : String15);
Var
Size : Integer;
Match : String15;
c : NumNodePtr;
Begin
Size := Length(Str);
c := Base;
p := c;
Match := Copy(c^.Name,1,Size);
While (Str <> Match) and (c <> Nil) Do
Begin
p := c;
c := c^.Next;
Match := Copy(c^.Name,1,Size)
End;
GotoXY(10,12);
If c = nil then Writeln('Name not found')
Else Writeln(c^.Name,' ',c^.Number);
End;
Procedure Find;
Var
x : Char;
Str : String15;
c : NumNodePtr;
Begin
ClrScr;
GotoXY(10,10); Write('Name to search for : ');
Readln(Str); Writeln; Writeln;
FindNode(c,Str);
GotoXY(10,14);Writeln('Hit return to continue');Read(x);
End;
Procedure DelNode;
Var
Str : String15;
c,p : NumNodePtr;
x : Char;
Begin
ClrScr;
GotoXY(10,10); Write('Enter name to delete : ');
Readln(Str);
FindNode(p,Str);
If (p^.Next <> Nil) or (Copy(p^.Name,1,Length(Str)) = Str) then
Begin
GotoXY(10,14); Write('Are you sure ? ');Readln(x);
If x in ['y','Y'] then
If (p = Base) and
(Copy(p^.Name,1,Length(Str)) = Str) then { Del Base }
Begin
Base := p^.Next;
Dispose(p);
End
Else { Del end or middle }
Begin
c := p^.Next^.Next;
Dispose(p^.Next);
p^.Next := c
End;
End;
GotoXY(10,14);Writeln('Hit return to continue');Read(x);
End;
Procedure Menu;
Var
x : Char;
c : NumNodePtr;
Begin
x := ' ';
Clrscr;
TextColor(04);
GotoXY(33,3) ; Writeln('Phone List');
GotoXY(32,4) ; Writeln('------------');
GotoXY(30,6) ; Writeln('By Gregory S Gray');
TextColor(04); GotoXY(29,09); Write('A');
TextColor(9) ; Writeln('dd to phone list.');
TextColor(04); GotoXY(29,11); Write('F');
TextColor(9) ; Writeln('ind a phone number.');
TextColor(04); GotoXY(29,13); Write('P');
TextColor(9) ; Writeln('rint the phone list.');
TextColor(04); GotoXY(29,15); Write('S');
TextColor(9) ; Writeln('ave phone list');
TextColor(04); GotoXY(29,17); Write('D');
TextColor(9) ; Writeln('elete entry');
TextColor(04); GotoXY(29,19); Write('Q');
TextColor(9) ; Writeln('uit to Dos');
TextColor(04);
While not(x in ['A','a','p','P','F','f','q','Q','s','S','d','D']) do
Begin
GotoXY(29,21);
Write('What will it be ? ');
GotoXY(47,21);
Readln(x);
End;
Case x of
'p','P' : PrintList;
'f','F' : Find;
'a','A' : AddNode;
's','S' : UpdateFile;
'd','D' : DelNode;
'q','Q' : Begin
GotoXY(29,23); Write('Are you sure ? ');Readln(x);
If x in ['y','Y'] then
Begin
GotoXY(24,23);
Done := True;
Write('Do you wish to save the phone list ? ');
Readln(x);
If x in ['y','Y'] then UpdateFile;
End;
End;
End;
End;
Begin
Init;
While Not(Done) do Menu;
End.
If Base = Nil then Base := c
Else p^.Next := c;
c^.Next := N